unit uEdifTree ;

interface

uses
    Graphics,
    GDIPOBJ,
    GDIPAPI,
    VirtualTrees,
    Classes,
    Types,
    uEdif ;

type

    TEdifStructure = class
    private
        fViewer : TVirtualStringTree ;
        fList : PEdif ;
        procedure GetNodeDataSize( Sender : TBaseVirtualTree ; var NodeDataSize : Integer ) ;
        procedure GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Column : TColumnIndex ; TextType : TVSTTextType ; var CellText : WideString ) ;
        procedure SetViewer( const Value : TVirtualStringTree ) ;
        procedure GetImageIndex( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
            Kind : TVTImageKind ; Column : TColumnIndex ; var Ghosted : Boolean ;
            var ImageIndex : Integer ) ;
        procedure BeforeCellPaint( Sender : TBaseVirtualTree ; TargetCanvas : TCanvas ;
            Node : PVirtualNode ; Column : TColumnIndex ; CellRect : TRect ) ;
        procedure GetBackColor( Node : PVirtualNode ; var ItemColor : TGPColor ) ;
    procedure Redraw;
    procedure Refresh;
    procedure SetList(const Value: PEdif);
    public
        constructor Create( AOwner : TComponent ) ; override ;
        destructor Destroy ; override ;

        property List : PEdif read fList write SetList ;
    end ;

var
    EdifStructTree  : TEdifStructure ;

implementation

uses
    uBasic ;

procedure TEdifStructure.SetViewer( const Value : TVirtualStringTree ) ;
begin
    fViewer := Value ;
    if fViewer = nil then
        Exit ;
    fViewer.OnGetNodeDataSize := GetNodeDataSize ;
    fViewer.OnGetText := GetText ;
    fViewer.OnGetImageIndex := GetImageIndex ;
    fViewer.OnBeforeCellPaint := BeforeCellPaint ;
end ;

procedure TEdifStructure.Redraw ;
var
    Data            : PTreeData ;

    procedure AddTreeNode( aNode : PVirtualNode ; P : PEdif ) ;
    var
        bNode       : PVirtualNode ;
    begin
        with fViewer do begin
            if P^.car = nil then begin
                aNode := AddChild( aNode ) ;
                Data := GetNodeData( aNode ) ;
                Data^.aText := P^.atom ;
                P := P^.cdr ;
            end ;
            while assigned( P ) do begin
                if assigned( P^.car ) then
                    AddTreeNode( aNode, P^.car )
                else begin
                    bNode := AddChild( aNode ) ;
                    Data := GetNodeData( bNode ) ;
                    Data^.aText := P^.atom ;
                end ;
                P := P^.cdr ;
            end ;
        end ;
    end ;
begin
    if assigned( fViewer ) then
        with fViewer do begin
            BeginUpdate ;
            try
                Clear ;
                NodeDataSize := SizeOf( TTreeData ) ;
                if assigned( fList ) then
                    AddTreeNode( nil, fList ) ;
                Expanded[ RootNode.LastChild ] := True ;
            finally
                EndUpdate ;
            end ;
        end ;
end ;

procedure TEdifStructure.GetNodeDataSize( Sender : TBaseVirtualTree ; var NodeDataSize : Integer ) ;
begin
    NodeDataSize := SizeOf( TTreeData ) ;
end ;

procedure TEdifStructure.GetText( Sender : TBaseVirtualTree ; Node : PVirtualNode ;
    Column : TColumnIndex ; TextType : TVSTTextType ; var CellText : WideString ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) then
            case Column of
                0 : CellText := Data^.aText ;
            else
                CellText := '' ;
            end ;
    end ;
end ;

procedure TEdifStructure.GetImageIndex(
    Sender : TBaseVirtualTree ; Node : PVirtualNode ; Kind : TVTImageKind ;
    Column : TColumnIndex ; var Ghosted : Boolean ; var ImageIndex : Integer ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := Sender.GetNodeData( Node ) ;
        if assigned( Data ) and ( Column = 0 ) and ( Kind = ikState ) then begin
            if Data^.aText = 'cell' then
                ImageIndex := 2
            else if Data^.aText = 'instance' then
                ImageIndex := 0
            else if Data^.aText = 'net' then
                ImageIndex := 1 ;
        end ;
    end ;
end ;

procedure TEdifStructure.Refresh ;
begin
    if assigned( fViewer ) then
        fViewer.Repaint ;
end ;

procedure TEdifStructure.BeforeCellPaint( Sender : TBaseVirtualTree ;
    TargetCanvas : TCanvas ; Node : PVirtualNode ; Column : TColumnIndex ;
    CellRect : TRect ) ;
var
    BackColor       : TGPColor ;
    Ind             : Integer ;
    Rtl             : Boolean ;
    iGraphics       : TGPGraphics ;
    iBrush          : TGPSolidBrush ;
begin
    iGraphics := TGPGraphics.Create( TargetCanvas.Handle ) ;
    iBrush := TGPSolidBrush.Create( aclBackSch ) ;
    try
        BackColor := clWhite ;
        with Sender as TVirtualStringTree do
            if LineMode = lmBands then begin
                if Column = Header.MainColumn then begin
                    Ind := GetNodeLevel( Node ) * Indent ;
                    Rtl := ( Column >= 0 ) and ( Header.Columns[ Column ].BiDiMode = bdRightToLeft )
                        or ( Column < 0 ) and ( BiDiMode = bdRightToLeft ) ;
                    if Rtl then begin
                        Dec( CellRect.Right, Ind ) ;
                        Ind := Integer( Indent ) ;
                    end
                    else begin
                        Inc( CellRect.Left, Ind ) ;
                        Ind := -Integer( Indent ) ;
                    end ;
                end
                else begin
                    Ind := 0 ;
                    Rtl := False ;
                end ;

                GetBackColor( Node, BackColor ) ;
                if BackColor <> Color then begin  // fill cell
                    iBrush.SetColor( BackColor ) ;
                    iGraphics.FillRectangle( iBrush, MakeRect( CellRect ) ) ;
                end ;

                if Column = Header.MainColumn then begin
                    if Rtl then
                        CellRect.Left := CellRect.Right - Integer( Indent )
                    else
                        CellRect.Right := CellRect.Left + Integer( Indent ) ;
                    Inc( CellRect.Bottom ) ;

                    repeat
                        if BackColor <> Color then begin // fill vertical band
                            iBrush.SetColor( BackColor ) ;
                            iGraphics.FillRectangle( iBrush, MakeRect( CellRect ) ) ;
                        end ;

                        Node := Node.Parent ;
                        if not Assigned( Node ) or ( Node = RootNode ) then
                            Break ;

                        Inc( CellRect.Left, Ind ) ;
                        Inc( CellRect.Right, Ind ) ;
                        GetBackColor( Node, BackColor ) ;
                    until False ;
                end ;
            end ;
    finally
        iGraphics.Free ;
        iBrush.Free ;
    end ;
    inherited ;
end ;

procedure TEdifStructure.GetBackColor( Node : PVirtualNode ; var ItemColor : TGPColor ) ;
var
    Data            : PTreeData ;
begin
    if assigned( Node ) then begin
        Data := fViewer.GetNodeData( Node ) ;
        if assigned( Data ) then begin
            if Data^.aText = 'cell' then
                ItemColor := aclMedaObject
            else if Data^.aText = 'instance' then
                ItemColor := aclMedaObject
            else if Data^.aText = 'net' then
                ItemColor := aclMedaObject
            else
                ItemColor := aclMedaObject ;
        end ;
    end ;
end ;

constructor TEdifStructure.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TEdifStructure.Destroy;
begin

  inherited;
end;

procedure TEdifStructure.SetList(const Value: PEdif);
begin
  fList := Value;
end;

initialization
    EdifStructTree := TEdifStructure.Create ;

finalization
    EdifStructTree.Free ;

end.

